問題の説明
シート 2 の範囲内のセル名に基づいてシート (シート 1) を複製して名前を変更するために必要な VBA コード (VBA code needed to duplicate and rename a sheet (Sheet 1) based on cell names in a range on Sheet 2)
このワークブックには、(CAM) と (CAM) の 2 つのワークシートがあります。(DIST)
On (CAM) は、"Distributor" というタイトルのテーブルです。このテーブルに名前を入力すると、(DIST) タブが複製され、シート 1 の "Distributor" テーブルに入力した名前に変更されます。
これは私が使用しようとしたコードですが、 .....私はこれが苦手で、よくわかりません.
Sub AddSheets()
Dim xRg As Excel.Range
Dim wSh As Excel.Worksheet
Dim wBk As Excel.Workbook
Set wSh = ActiveSheet
Set wBk = ActiveWorkbook
Application.ScreenUpdating = False
For Each xRg In wSh.Range("A1:A7")
With wBk
.Sheets.Add after:=.Sheets(.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = xRg.Value
If Err.Number = 1004 Then
Debug.Print xRg.Value & " already used as a sheet name"
End If
On Error GoTo 0
End With
Next xRg
Application.ScreenUpdating = True
End Sub
リファレンスソリューション
方法 1:
Your program may work as follows: 1. For each entry in cam, check if a coresponding worksheet exists 2. if not, then create the worksheet by duplicating the dist worksheet:
Dim wBk As Workbook
Dim wSh as Worksheet, wNw as Worksheet
Dim xRg as Range
Set wBk = ActiveWorkbook
Set wSh = wBk.Workhseets("CAM")
Set xRg = wSh.Range("B2") ' Assuming your table "CAM" starts in cell B2
while not xRg.Value = ""
on error resume next
set wSh = wBk.Worksheets(xRg.Value) ' ‑‑‑ Try accessing worksheet
on error goto 0 ' ‑‑‑ Remove error handler
if wSh is nothing then ' ‑‑‑ no worksheet
set sSh = wBk.Worksheets("Dist") ' ‑‑‑ Source worksheet
set sNw = wBk.Worksheets.Add() ' ‑‑‑ New worksheet as target
sSh.UsedRange.Copy ' ‑‑‑ Copy all from source
sNw.Range("A1").PasteSpecial xlPasteAll
end if
wend
Good luck!
(by Gunit、QuantumRog)